perm filename PALIN.LST[S1,ALS] blob
sn#483568 filedate 1979-10-24 generic text, type T, neo UTF8
PASCAL/SAIL 1.1 6-SEP-79 COMPILATION LIST PRODUCED ON 24-OCT-79 AT 09:07:49 PAGE 1
1 C;
PASCAL/SAIL 1.1 6-SEP-79 COMPILATION LIST PRODUCED ON 24-OCT-79 AT 09:07:49 PAGE 2
1 (* $A+,D+*)
2
3 PROGRAM PALINDROME(OUTPUT);
4
5 CONST NUMMAX = 4; PALMAX = 100; NUMLIM = 7; PALLIM = 101;
6 TABMAX = 500; TABLIM = 501;
7 VAR C, I, J, K, L, M, N, NXTOT, TABL, NMAX, NMIN, DCLASS,
8 NUMVAL, CVAL, CVAL2, PALTOT, PALVAL, CARRY : INTEGER;
9 CMIN, CMAX : INTEGER;
10 NUM : ARRAY [1..NUMLIM] OF INTEGER;
11 PAL, PAL2 : ARRAY [1..PALLIM] OF INTEGER;
12 TAB : ARRAY [0..TABLIM] OF INTEGER;
13 TEMP : ARRAY [1..5] OF INTEGER;
14
15
16 PROCEDURE TYPTEMP (K : INTEGER);
17 VAR I, J : INTEGER;
18 BEGIN
19 I := K;
20 FOR J := 1 TO CVAL DO
21 BEGIN
22 TEMP[J] := I MOD 19;
23 I := I DIV 19;
24 END;
25 FOR J := CVAL DOWNTO 1 DO
26 WRITE (TTY,TEMP[J]:4);
27 WRITE(TTY,' ');
28 END;
29
30
31 BEGIN (* MAIN PROGRAM*)
32 FOR I := 1 TO NUMMAX DO NUM[I] := 0;
33 NUM [2] := 1; NUMVAL := 2; (* INITIAL CONDITIONS *)
34 WRITELN (OUTPUT,
35 ' PALINDROME FORMATION TESTED TO A MAXIMUM OF',PALMAX:4,' DIGITS');
36 WRITELN (OUTPUT);
37 WHILE NUMVAL <= NUMMAX DO
38 BEGIN (*WHILE NUMVAL <= NUMMAX*)
39 CVAL := NUMVAL DIV 2;
40 CVAL2 := CVAL + NUMVAL MOD 2;
41 CMIN := 1;
42 CMAX := 19;
43 IF CVAL > 1 THEN FOR I := 2 TO CVAL DO
44 BEGIN
45 CMIN := CMIN * 19;
46 CMAX := CMAX * 19;
47 END;
48 IF (CVAL2 - CVAL) = 1 THEN
49 BEGIN
50 CMIN := CMIN * 10;
51 CMAX := CMAX * 10;
52 END;
53 CMAX := CMAX - 1;
54
55 WRITELN (OUTPUT,'DATA FOR',NUMVAL:2,'-DIGIT DECIMAL NUMBERS');
56 I := CMAX -CMIN + 1;
57 WRITELN(OUTPUT,' WHICH CAN BE GROUPED INTO',I:5,' CLASSES');
58 WRITELN(OUTPUT);
59 WRITELN(TTY);
60 WRITELN (TTY,'DATA FOR',NUMVAL:2,'-DIGIT DECIMAL NUMBERS'); BREAK;
61 DCLASS := NUMVAL;
62 FOR I := 1 TO PALMAX DO PAL[I] := 0;
63 FOR I := 0 TO TABMAX DO TAB[I] := 0; (* PALINDROME ADD DATA *)
64 PALTOT := 0; (* COUNT OF NUMBER OF PALINDROMES *)
65 NXTOT := 0; (* COUNT OF NON-PALINDROMES*)
66 NMAX := 0; (* MAXIMUM ADDS FOR A PALINDROME*)
67 NMIN := 500; (* MINIMUN ADDS FOR INTRANSIGENTS *)
68 M := 0;
69 FOR C := CMIN TO CMAX DO
70 BEGIN (* FOR C := CMIN TO CMAX*)
71 I := C;
72 J := CVAL; L := CVAL2 + 1;
73 IF (CVAL2 - CVAL) = 1 THEN
74 BEGIN
75 TEMP[CVAL2] := I MOD 10;
76 NUM[CVAL2] := TEMP[CVAL2];
77 I := I DIV 10;
78 END;
79 FOR K := CVAL DOWNTO 1 DO
80 BEGIN
81 TEMP[K] := I MOD 19;
82 IF TEMP[K] < 10 THEN
83 BEGIN
84 IF K = 1 THEN
85 BEGIN
86 NUM[L] := TEMP[K] -1;
87 NUM[J] := 1;
88 END
89 ELSE
90 BEGIN
91 NUM[L] := TEMP[K];
92 NUM[J] := 0;
93 END;
94 END
95 ELSE
96 BEGIN
97 NUM[L] := 9;
98 NUM[J] := TEMP[K] - 9;
99 END;
100 J := J - 1;
101 L := L + 1;
102 I := I DIV 19;
103 END;
104 (* FOR I := 1 TO NUMVAL DO WRITE(TTY,NUM[I]:1); WRITE(TTY,' '); *)
105 N := 0; (* TO COUNT NUMBER OF ADDITIONS *)
106 FOR I := 1 TO NUMVAL DO PAL[I] := NUM[I];
107 FOR I := NUMVAL + 1 TO PALMAX DO PAL[I] := 0;
108 PALVAL := NUMVAL;
109 WHILE PALVAL <= PALMAX DO
110 BEGIN (* WHILE PALVAL <= PALMAX*)
111 I := 1; J := PALVAL;
112 WHILE ((PAL[I] = PAL [J]) AND (I < J)) DO
113 BEGIN
114 I := I + 1; J := J - 1;
115 END;
116 IF I >= J THEN
117 BEGIN
118 TAB[N] := TAB[N] + 1; (*ADD TO TABLE OF DEPTHS*)
119 IF N > NMAX THEN NMAX := N;
120 PALTOT := PALTOT + 1;
121 PALVAL := PALMAX + 1;
122 END
123 ELSE (* STILL NOT A PALINDROME*)
124 BEGIN (* TRY ANOTHER ADD*)
125 J := PALVAL; CARRY := 0;
126 FOR I := 1 TO PALVAL DO
127 BEGIN (* ADD NUMBERS*)
128 PAL2[I] := PAL[I] + PAL[J] + CARRY;
129 IF PAL2[I] > 9 THEN
130 BEGIN
131 PAL2[I] := PAL2[I] - 10; CARRY := 1;
132 END
133 ELSE CARRY := 0;
134 J := J - 1;
135 END; (* ADD NUMBERS*)
136 IF CARRY = 1 THEN
137 BEGIN
138 PALVAL := PALVAL +1; PAL2[PALVAL] := 1;
139 END;
140 N := N + 1;
141 IF PALVAL = PALMAX + 1 THEN (* LIMIT ON DEPTH*)
142 BEGIN (* ONE TO REPORT*)
143 IF N < NMIN THEN NMIN := N;
144 NXTOT := NXTOT + 1;
145 IF NXTOT = 1 THEN
146 BEGIN
147 WRITELN(OUTPUT,
148 'INTRANSIGENT CLASSES DEFINED BY REVERSED DIGIT ADDITIONS, WITHOUT CARRIES');
149 WRITELN(OUTPUT,
150 ' * MEANS,- ONE NUMBER IN THIS CLASS IS AN INITIAL PALINDROME');
151 WRITELN(OUTPUT);
152 FOR J := 1 TO 3 DO
153 BEGIN
154 WRITE(OUTPUT,' ');
155 FOR I := 1 TO CVAL DO WRITE (OUTPUT,' SUM',I:1);
156 IF (CVAL2 - CVAL) = 1 THEN WRITE (OUTPUT,' MID#');
157 WRITE(OUTPUT,' ');
158 END;
159 WRITELN (OUTPUT);
160 M := 0;
161 END;
162 WRITE(OUTPUT,' ');
163 WRITE(TTY,' ');
164 FOR J := 1 TO CVAL2 DO
165 BEGIN
166 WRITE (OUTPUT,TEMP[J]:5);
167 WRITE (TTY,TEMP[J]:3);
168 END;
169 J := 1;
170 WHILE ((J <= CVAL) AND ((TEMP[J] MOD 2) = 0)) DO J := J + 1;
171 IF J > CVAL THEN WRITE(OUTPUT,' *') ELSE WRITE(OUTPUT,' ');
172 M := M + 1;
173 IF (M MOD 3) = 0 THEN WRITELN(OUTPUT);
174 END (* OF ONE TO REPORT*)
175 ELSE FOR I := 1 TO PALVAL DO PAL[I] := PAL2[I];
176 END;
177 END (* WHILE PALVAL <= PALMAX*);
178 END; (* FOR C := CMIN TO CMAX*)
179 IF NXTOT = 0 THEN WRITELN (OUTPUT,' NO INTRANSIGENT NUMBERS FOUND');
180 WRITELN (OUTPUT);
181 WRITELN(OUTPUT);
182 WRITELN (OUTPUT,NMAX:6,' MAX ADDS FOR',PALTOT:7,' PALINDROME CLASSES, WITH',
183 NXTOT:6,' INTRANSIGENT CLASSES');
184 IF NXTOT = 0 THEN WRITELN (OUTPUT,' NO INTRANSIGENT NUMBERS FOUND') ;
185 WRITELN(OUTPUT);
186 WRITELN(OUTPUT,'PALINDROMES GROUPED AS TO THEIR ADD DEPTHS');
187 WRITELN(OUTPUT,
188 ' 0-ADD GROUP ALSO INCLUDES INDIVIDUAL PALINDROMES INDICATED BY * ABOVE');
189 WRITELN(OUTPUT);
190 WRITELN(OUTPUT,
191 ' ADDS CLASSES ADDS CLASSES ADDS CLASSES ADDS CLASSES');
192 M := 0;
193 FOR I := 0 TO NMAX DO
194 BEGIN
195 IF TAB[I] <> 0 THEN
196 BEGIN
197 WRITE(OUTPUT,I:10,TAB[I]:6);
198 M := M + 1;
199 IF (M MOD 4) = 0 THEN WRITELN(OUTPUT);
200 END;
201 END;
202 WRITELN(OUTPUT);
203 WRITELN(OUTPUT);
204 NUMVAL := NUMVAL + 1;
205 END (*WHILE NUMVAL <= NUMMAX*);
206 END.
0 ERROR(S) DETECTED
HIGHSEG: 0K + 931 WORD(S)
LOWSEG : 0K + 832 WORD(S)
RUNTIME: 00:00.775 ELAPSED: 00:00:07.1 7568 CHARS